home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / t_rex10 / trexdm02.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  3KB  |  152 lines
  1. unit Trexdm02;
  2.  
  3. {
  4. $Log:   W:/users/prodigy/prodig~1/archive/trex/trexdm02.pav  $
  5.  * 
  6.  *    Rev 1.1   07 Apr 1996 18:30:52   PaulK
  7.  * Work in progress on demos
  8. }
  9.  
  10. interface
  11.  
  12. uses
  13.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  14.   Forms, Dialogs, Buttons, StdCtrls, ExtCtrls, T_Rex, Gauges;
  15.  
  16. type
  17.   TCounter = class(TObject)
  18.     value: longint;
  19.   constructor Create;
  20.   procedure Increment;
  21.   end;
  22.  
  23. type
  24.   TForm1 = class(TForm)
  25.     Rex1: TRex;
  26.     OpenDialog1: TOpenDialog;
  27.     Label1: TLabel;
  28.     Bevel1: TBevel;
  29.     Button1: TButton;
  30.     Button2: TButton;
  31.     BitBtn1: TBitBtn;
  32.     Bevel2: TBevel;
  33.     Label2: TLabel;
  34.     Label3: TLabel;
  35.     Gauge1: TGauge;
  36.     procedure Button1Click(Sender: TObject);
  37.     procedure Button2Click(Sender: TObject);
  38.     procedure Rex1EOF(Sender: TObject);
  39.     procedure Rex1BeforeLineMatch(Sender: TObject);
  40.     procedure Rex1BOF(Sender: TObject);
  41.     procedure Rex1Token(Sender: TObject; const Token: String);
  42.   private
  43.     { Private declarations }
  44.     Wordlist: TStringList;
  45.     Sortedlist: TStringList;
  46.     WordPattern: TRegExp;
  47.   public
  48.     { Public declarations }
  49.   end;
  50.  
  51. var
  52.   Form1: TForm1;
  53.  
  54. implementation
  55.  
  56. {$R *.DFM}
  57.  
  58. procedure TForm1.Button1Click(Sender: TObject);
  59. begin
  60. if OpenDialog1.Execute then
  61.   begin
  62.   Rex1.FileSpec := OpenDialog1.Filename;
  63.   Button2.Enabled := true;
  64.   end
  65. else
  66.   Button2.Enabled := false;
  67.  
  68. end;
  69.  
  70. procedure TForm1.Button2Click(Sender: TObject);
  71. begin
  72. Screen.Cursor := crHourglass;
  73. Rex1.Scan;
  74. Screen.Cursor := crDefault;
  75. end;
  76.  
  77. procedure TForm1.Rex1EOF(Sender: TObject);
  78.  
  79. var s: string; i: integer;
  80.  
  81. begin
  82. Gauge1.Progress := Gauge1.MaxValue;
  83. with WordList do
  84. for i := 0 to pred(Count) do
  85.   begin
  86.   s := Format('%06d %s',[MaxInt-(Objects[i] as TCounter).value,Strings[i]]);
  87.   SortedList.Add(s);
  88.   end;
  89.  
  90. s := '';
  91. for i := 0 to 9 do
  92.   begin
  93.   s := s + ' ' + copy(Sortedlist.Strings[i],8,255);
  94.   if i > pred(SortedList.Count) then break;
  95.   end;
  96.  
  97. With Rex1 do
  98.   Label2.Caption :=
  99.   Format('The commonest 10 words in %s are:%s.',
  100.   [Filename,s]);
  101.  
  102. WordList.Free;
  103. SortedList.Free;
  104. WordPattern.Free;
  105. end;
  106.  
  107. procedure TForm1.Rex1BeforeLineMatch(Sender: TObject);
  108. begin
  109. Label2.Caption := Format('Scanning %s  line %4d',[Rex1.Filename,Rex1.ScanLineNumber]);
  110. Label2.Refresh;
  111. Gauge1.Progress := Rex1.FilePosition;
  112. end;
  113.  
  114. procedure TForm1.Rex1BOF(Sender: TObject);
  115. begin
  116. Gauge1.MaxValue := Rex1.Filesize;
  117. WordList := TStringList.Create;
  118. SortedList := TStringList.Create;
  119. SortedList.Sorted := true;
  120. WordPattern := TRegExp.Create('^[A-Za-z''-]+$');
  121. end;
  122.  
  123. procedure TForm1.Rex1Token(Sender: TObject; const Token: String);
  124.  
  125. var
  126.   i: Longint; s, l: word;
  127.  
  128. begin
  129. if not WordPattern.Match(Token,s,l) then
  130.   exit;
  131. i := WordList.IndexOf(Token);
  132. if i = -1 then {not in list}
  133.   WordList.AddObject(Token,TCounter.Create)
  134. else
  135.   (WordList.Objects[i] as TCounter).Increment;
  136. end;
  137.  
  138. constructor TCounter.Create;
  139.  
  140. begin
  141. inherited Create;
  142. value := 1;
  143. end;
  144.  
  145. procedure TCounter.Increment;
  146.  
  147. begin
  148. inc(value);
  149. end;
  150.  
  151. end.
  152.